;UNLOCK - Give "unlock (filename or match) (keyword)"

base equ 0
dmad1 equ base+80h
fcb1 equ base+5ch
ftp equ 9 ;file type increment
fex equ 12
fss equ 13
frc equ 15
fdd equ 16
fcr equ 32
frr equ 33
secmax equ 32 ;8k buf, read and write interleaved

dfldrv:: db 0 ;keeps default drive
stackp:: dw 0 ;keeps stack ptr
secct:: db 0 ;sector ct, read
csecct:: db 0 ;ditto code
rdma:: dw 0 ;running dma
attrb:: db 0 ;keeps r/o attribute byte
nunqfl:: db 0 ;indic file spec not unique
tmpex:: db 'TMP'
prltyp:: db 'LRL'
dirpt:: dw 0 ;directory ptr
fcb2:: ds 36
fcb3:: ds 36

start:: ld (stackp),sp
 ld sp,stac0
 ld c,19h
 call base+5
 ld (dfldrv),a ;keep default drive
 call paschc ;ret z if no keyword
 jp z,nopsds
 call pascod ;code keyword, ret c if invalid
 jp c,invdis
 call dmshmk ;make 1 rec of coded mush and
  ;write part over keyword
 call nunqst ;set nunqfl nz if fcb1 has qmks
 call makdir ;make directory of matched files
  ;ret z if none, c if more than 32
 jp z,nofdis
 call c,toodis
 ld hl,0
 ld (dirpt),hl ;zero directory ptr
codlp:: call getdir ;dir adr of next file to fcb2
  ;ret z if no more, c if file empty
 jr z,reb
 call c,empdis ;also preserves c flag
 call nc,codit ;read buf full, code, write,
  ;del original, rename, msg
  ;msg and reb if no dir space
  ;msg and reb if ctrl c
jr codlp

reb:: ld a,(dfldrv)
 ld e,a
 ld c,0eh
 call base+5 ;reset default drive
 ld sp,(stackp)
 jp base

 ;sr make directory of files matching fcb1
makdir:: ld hl,fcb1+fex
 ld b,3
mdr2:: ld (hl),0
 djnz mdr2 ;zero ex and ss bytes
 ld de,fcb1
 ld c,11h
 call base+5 ;search for first
 cp 0ffh
 ret z
mdr3:: and 3
 rrca
 rrca
 rrca
 ld hl,dmad1
 ld c,a
 ld b,0
 add hl,bc ;dir entry
 ex de,hl
 ld hl,(dirpt) ;local dir ptr
 ld a,h
 sub 4
 ccf
 ret c ;if too many matching files
 ld bc,dirbuf
 add hl,bc
 ex de,hl ;ptrs for block load
 ld bc,32
 ldir ;transcribe to local dir
 ld hl,(dirpt) ;will update ptr ctr
 ld de,32
 add hl,de
 ld (dirpt),hl
 ld de,fcb1
 ld c,12h
 call base+5 ;search for next
 cp 0ffh
 jr nz,mdr3
 xor a
 inc a ;nz and nc flags if finished
 ret

 ;sr get dir adr of next file to fcb2
 ;ret z if no more, ret c if file empty
getdir:: ld hl,(dirpt)
 ld a,h
 sub 4
 ret z ;if no more
 push hl
 ld de,32
 add hl,de
 ld (dirpt),hl ;for next time
 pop hl
 ld de,dirbuf
 add hl,de
 push hl
 pop ix
 inc hl ;ptr to filename
 ld a,(hl)
 or a
 ret z ;if no more files
 ld a,(fcb1) ;drive
 ld de,fcb2
 ld (de),a ;same dr in fcb2
 inc de
 ld bc,12
 ldir ;transcribe name, type, ext
 ld hl,0
 ld (fcb2+fex),hl
 ld (fcb2+fss),hl ;zero ex and ss bytes
 ld a,(ix+15)
 or a
 jr nz,gdr2
 scf ;to indicate empty
gdr2:: inc c ;set nz flag
 ret

 ;sr read buf, code, write, delete orig,
 ;rename, msg
 ;msg and reb if no dir space
 ;msg and reb if ctrl c
codit:: call atrchc ;ret nz if sys, or keep r/o byte
 jp nz,sysdis ;msg and ret from codit
 call open ;open fcb2
 xor a
 ld (fcb2+fcr),a
 ld de,buf0
 call rdsec
 jp nz,nregds ;if eof
 ld de,buf0+80h
 call rdsec
 jp nz,nregds
 call comp ;ret nz if mush mismatch
 jp nz,nregds ;'File (namif) irreg or not locked,
  ;'or wrong keyword'
dcd2:: call wfmk ;make write fcb3 and make file
  ;includes delete
  ;ret z if no dir space
 jp z,noddis
 call mushtr ;transcribe mush
 xor a
 ld (fcb3+fcr),a
cdtlp:: call rdbuf ;read to buf, ret nz if passed eof
  ;ctrl c checks
 ex af,af'
 ld a,(secct)
 or a
 jr z,cdt2
 call codbuf ;code buffer
 call wrbuf ;write buffer, reb if disk full
  ;ctrl c checks
 ex af,af'
 jr z,cdtlp
cdt2:: call eschc ;ret z if ctrl c
 jr z,escout
 call close ;close write file fcb3
 ld de,fcb2
 call delete ;delete original
 call ren ;rename fcb3 file as fcb2
  ;also turns lrl to prl
 call dondis ;'File (name) unlocked', omit
  ;name if unique
 ret

 ;sr ret z if ctrl c inp
eschc:: ld e,0ffh
 ld c,6
 call base+5
 cp 3
 ret

escout:: ld de,fcb3
 call delete
 jp abdis ;'Aborted'

 ;sr ret z if no keyword
paschc:: ld a,(fcb1+fdd+1) ;keyword
 cp 20h
 ret

 ;sr code keyword, ret c if invalid
pascod:: ld ix,fcb1+fdd+1 ;keyword
 ld de,4 ;arb start pt
 ld b,8 ;ct
plp:: ld hl,pag1+50h ;res to be put here
 add hl,de
 ld a,(ix)
 call chcvld ;ret nc if valid char
 ret c
 add a,(hl)
 ld c,a
 and 55h
 rlca
 xor c
 ld (hl),a
 inc ix
 ld a,e
 add a,3
 and 7 ;col incr for ptr
 ld e,a
 djnz plp
 or a ;clear carry
 ret

 ;sr ret c if invalid keyword char
chcvld:: cp ' '
 ret z
 cp '/'
 ret c
 cp ':'
 jr c,chc2
 cp '@'
 ret c
 cp '['
chc2:: ccf
 ret

 ;sr make 128 bytes of mush and
 ;write part over keyword
dmshmk:: ld c,51 ;arb start pt
 ld b,80h ;length
mlp:: ld hl,pag1+80h
 ld a,c
 add a,l
 ld l,a
 jr nc,mlp2
 inc h
mlp2:: ld ix,pag1+50h ;mush at keyword addr
 ld a,b ;use b value for keyword ptr
 and 7
 ld e,a
 ld d,0
 add ix,de
 ld a,(ix)
 add a,(hl)
 ld e,a
 and 0aah
 rra
 xor e
 ld (hl),a
 ld a,c
 add a,23 ;col incr
 and 7fh
 ld c,a
 djnz mlp
 ld ix,pag1+50h ;will write some over keyword
 ld de,4
 ld b,30h
putlp:: ld hl,pag1+80h
 add hl,de
 ld a,(hl)
 ld (ix),a
 inc ix
 ld a,e
 add a,15
 and 7fh
 ld e,a
 djnz putlp
 ld l,18h ;='jr'
 ld h,122h-175h
 ld (pag1+73h),hl
 ret

 ;sr set nunqfl if fcb1 has qmks
nunqst:: ld hl,fcb1+1
 ld a,'?'
 ld b,11
tunqlp:: cp (hl)
 jr z,tunqot
 inc hl
 djnz tunqlp
 xor a
tunqot:: ld (nunqfl),a
 ret

 ;sr check file attributes, store r/o byte
 ;ret nz if sys
atrchc:: ld hl,fcb2+ftp
 ld a,(hl)
 ld (attrb),a
atr2:: inc hl
 bit 7,(hl)
 ret

 ;sr make write fcb3 and make file
 ;ret z if nmo dir space
wfmk:: ld hl,fcb2
 ld de,fcb3
 ld bc,9
 ldir ;dr and filename
 ld hl,tmpex
 ld bc,3
 ldir ;'TMP' extension
 ld b,3
 ex de,hl
wfm2:: ld (hl),0
 inc hl
 djnz wfm2 ;zero ex and ss bytes
 ld de,fcb3
 call delete ;del any equiv file
 ld de,fcb3
 ld c,16h
 call base+5 ;make file
 inc a
 ret

 ;sr delete (de) file
delete:: ld c,13h
 call base+5
 ret

 ;sr transcribe dmush
mushtr:: ld hl,pag1+80h
 ld de,upmush
 ld bc,80h
 ldir
 ret

 ;sr open read fcb2
open:: ld de,fcb2
 ld c,0fh
 call base+5
 ret

 ;sr read to buf, ret nz if eof before end, ctrl c checks
rdbuf:: ld de,buf0
 xor a
 ld (secct),a
rdlp:: ld (rdma),de
 call rdsec ;read 1 sector, ret nz if passed eof
  ;ctrl c check
 ret nz ;if passed eof
 ld hl,secct
 inc (hl)
 ld a,secmax
 cp (hl)
 ret z ;if end of buf
 ld de,(rdma)
 inc d
 jr rdlp

 ;sr read sector to (de), ret nz if eof
 ;ctrl c check
rdsec:: ld c,1ah
 call base+5 ;set dma
 call eschc
 jp z,escout
 ld de,fcb2
 ld c,14h
 call base+5 ;read sequential
 or a
 ret ;nz if eof

 ;sr code buffer
codbuf:: xor a
 ld (csecct),a
 ld de,buf0 ;rrec start
 ld ix,buf0+80h ;wrec start
cblp:: call cdr ;code data record
 ex de,hl
 ld de,80h
 add hl,de
 add ix,de ;next wrec
 ex de,hl ;next rrec in de
 ld hl,csecct
 inc (hl)
 ld a,(secct)
 sub (hl)
 jr nz,cblp
 ret

 ;sr code data record, rrec de, wrec ix
cdr:: ld hl,upmush
 ld b,80h
cdlp:: ld a,(de)
 ld c,a
 and 55h
 rlca
 xor c
 sub (hl)
 ld (hl),c
 ld (ix),a
 inc hl
 inc de
 inc ix
 djnz cdlp
 ret

 ;sr ret nz if record mismatches pag1
comp:: ld hl,buf0+40h
 ld de,pag1+40h
 ld b,0c0h
cmplp:: ld a,(de)
 cp (hl)
 ret nz
 inc hl
 inc de
 djnz cmplp
 ret

 ;sr write buffer, ret z if disk full
wrbuf:: ld de,buf0+80h ;initial dma in de
wblp:: ld (rdma),de
 call wrsec
 jp nz,stflds
 ld de,(rdma)
 inc d
 ld hl,secct
 dec (hl)
 jr nz,wblp
 ret

 ;sr write record from (de), ret nz if disk full
 ;ctrl c check
wrsec:: ld c,1ah
 call base+5 ;set dma
 call eschc
 jp z,escout
 ld de,fcb3
 ld c,15h
 call base+5 ;write sequential
 or a
 ret

 ;sr close file
close:: ld de,fcb3
 ld c,10h
 call base+5
 ret

 ;sr rename write file as read file
 ;.prl becomes .lrl
ren:: call prllrl ;rename prl file as lrl
 ld de,fcb2
 call delete
 ld hl,fcb2
 ld de,fcb3+16
 ld bc,16
 ldir
 ld hl,fcb3+ftp
 ld a,(attrb)
 and 80h
 ld b,a
 ld a,(hl)
 and 7fh
 or b
 ld (hl),a ;to ensure r/o byte is kept
 ld de,fcb3
 ld c,17h
 call base+5
 ret

 ;sr rename lrl file as prl
prllrl:: ld de,fcb2+ftp
 ld hl,prltyp
 ld b,3
prl2:: ld a,(de)
 and 7fh
 cp (hl)
 ret nz
 inc hl
 inc de
 djnz prl2
 ex de,hl
 dec hl
 dec hl
 dec hl
 ld (hl),'P'
 ret

nopsds:: ld de,nopmsg
 jp streb
nopmsg:: db 'A valid keyword must be specified'
 db 0dh,0ah,'$'

invdis:: ld de,invmsg
 jp streb
invmsg:: db 'Wrong keyword',0dh,0ah,'$'

nofdis:: ld de,nofmsg
 jp streb
nofmsg:: db 'No file',0dh,0ah,'$'

toodis:: ld de,toomsg
 jp string
toomsg:: db 'Limit of 32 matching files'
 db 0dh,0ah,'$'

sysdis:: ld de,sysms1
 call string
 call namif
 ld de,sysms2
 jp string ;ret from codit sr when done
sysms1:: db 'File $'
sysms2:: db 'has system attribute',0dh,0ah,'$'

empdis:: push af ;keep c flag
 ld de,empms1
 call string
 call namif
empds2:: ld de,empms2
 call string
 pop af ;restore c flag
 ret
empms1 equ sysms1
empms2:: db 'empty',0dh,0ah,'$'

noddis:: ld de,nodmsg
 jp streb
nodmsg:: db 'No directory space for operation'
 db 0dh,0ah,'$'

dondis:: ld de,donms1
 call string
 call namif
 ld de,donms2
 jp string
donms1 equ sysms1
donms2:: db 'unlocked',0dh,0ah,'$'

abdis:: ld de,abmsg
 jp streb
abmsg:: db '------------Aborted',0dh,0ah,'$'

stflds:: ld de,fcb3
 call delete
 ld de,stflms
 jp streb
stflms:: db 'Disk full - aborting',0dh,0ah,'$'

nregds:: ld de,nrgms1
 call string
 call namif
 ld de,nrgms2
 jp string
nrgms1 equ sysms1
nrgms2:: db 'irregular or not locked',0dh,0ah
 db '   or wrong keyword',0dh,0ah,'$'

string:: ld c,9
 call base+5
 ret

streb:: call string
 jp reb

namif:: ld a,(nunqfl)
 or a
 ret z
 ld hl,fcb2
 ld a,(hl)
 or a
 jr z,namf2
 add a,40h
 call disp
 ld a,':'
 call disp
namf2:: inc hl
 ld b,8
nlp:: ld a,(hl)
 cp 20h
 jr z,namf3
 call disp
 inc hl
 djnz nlp
namf3:: ld a,'.'
 call disp
 ld hl,fcb2+ftp
 ld b,3
nlp2:: ld a,(hl)
 cp 20h
 jr z,namf4
 call disp
 inc hl
 djnz nlp2
namf4:: ld a,20h
 jp disp

disp:: push bc
 push de
 push hl
 ld e,a
 ld c,2
 call base+5
 pop hl
 pop de
 pop bc
 ret

pag1:: .phase base+100h

 db 0dh,0ah,'==<Locked file>== ',0dh,0ah,1ah
  ;as a seq of instns, this gives a jump either to
  ;122h or to 173h

fill:: ds base+122h-fill ;foll instn shd be 122h
  ;173h will be set to jr 122h later

sendms:: ld hl,base+100h
 ld a,(hl)
 cp 1ah
 jp z,base
 push bc
 push de
 push hl
 ld e,a
 ld c,2
 call base+5
 pop hl
 pop de
 pop bc
 inc hl
 jr sendms+3

  ;next byte 13ah
 db 0f5h,79h,10h,0afh,23h,09h
 db 51h,00h,19h,71h,0d9h,6fh,0b8h,0b6h
 db 70h,26h,0a6h,63h,51h,03h,44h,20h

nmush:: db 57h,7eh,0c5h,14h,8fh,47h,0c1h,27h ;adr 150h
 db 0feh,0eeh,9fh,0edh,09h,0a9h,33h,76h
 db 0e2h,11h,72h,0d7h,0e3h,5dh,74h,66h
 db 66h,39h,0fh,2dh,15h,34h,0ch,81h
 db 25h,61h,33h,09h,12h,3eh,4eh,37h
 db 96h,0b0h,0ebh,41h,89h,0a0h,24h,78h

dmush:: db 48h,0e0h,23h,0afh,2ah,77h,0f6h,86h ;adr 180h
 db 0c3h,3ah,0d8h,7eh,5bh,7fh,0c1h,0eh
 db 57h,0f8h,30h,26h,11h,0fh,2eh,0d8h
 db 08h,6dh,0bah,7fh,8ch,0cch,90h,4ah

 db 95h,0a5h,0e4h,9fh,76h,5fh,0e0h,01h
 db 1fh,22h,9ah,77h,3ch,5dh,0a0h,0a7h
 db 75h,0a7h,0cfh,76h,0ach,40h,6fh,0aah
 db 3eh,79h,56h,5eh,69h,77h,3ah,64h

 db 3eh,56h,53h,4dh,01h,29h,47h,0b2h
 db 61h,85h,6ch,4ah,0a9h,0a2h,0d8h,0f3h
 db 9fh,4fh,0bah,32h,0c2h,43h,4dh,31h
 db 8ch,0ach,09h,58h,5ah,0fh,75h,0f7h

 db 0aah,73h,0a5h,9dh,0f3h,2dh,0beh,58h
 db 03h,4ah,0d9h,21h,30h,4eh,0d7h,75h
 db 0a8h,98h,82h,02h,41h,9ch,02h,0eh
 db 0c4h,61h,63h,61h,10h,0a2h,42h,48h

 .dephase

;WILL LATER INSERT MESSUP SECN HERE

upmush:: ds 80h ;to transcribe mush for updating
dirbuf:: ds 1024 ;directory of matched files
 ds 20h ;for stack
stac0::
buf0:: ds 8192 ;file buffer

 end start
